home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / superdir.arc / SUPERDIR.BAS
BASIC Source File  |  1980-01-01  |  5KB  |  97 lines
  1. 1 DIM F$(1000)
  2. 100 ' SUPER DIRECTORY COMPUTE APR 84 PAGE 176
  3. 110 ' FOR MONCHROME OR COLOR
  4. 120 SCREEN 0,0,0:WIDTH 80:COLOR 7,0:CLS:DEFINT A-Z:KEY OFF:FOR I=1 TO 10:KEY I,"":NEXT
  5. 130 CR$=CHR$(17)+CHR$(196)+CHR$(217)
  6. 140 PRINT "Welcome to ";:COLOR 15:PRINT "Super Directory":COLOR 7
  7. 150 'remove the word rem from the next line for automatic use of drive A
  8. 160 REM DRIVE$="A:":FSPEC$="A:*.*"GOTO 200
  9. 170 PRINT:PRINT "Select Drive: (";:COLOR 16,15:PRINT "A B";:COLOR 7,0:PRINT CHR$(29);CHR$(29);"/";CHR$(28);")"
  10. 180 DRIVE$=INKEY$+":":A=ASC(DRIVE$):IF (A OR 32)<97 OR (A OR 32)>98 THEN 180
  11. 190 DRIVE$=CHR$(A AND 223)+":":FSPEC$=DRIVE$+"*.*"
  12. 200 GOSUB 5000:CLS:COLOR 23:PRINT "Reading description file"
  13. 210 DIM D$(1000):FOR I=0 TO ENTRIES:D$(I)=CHR$(9)+"--":NEXT
  14. 220 ON ERROR GOTO 310
  15. 230 OPEN DRIVE$+"DESCR.DIR" FOR INPUT AS #1
  16. 240 LINE INPUT #1,DISKNAME$:LINE INPUT #1,A$:NUMREC=VAL(A$)
  17. 250 FOR ITEMS=0 TO NUMREC
  18. 260   LINE INPUT #1,F$:LINE INPUT #1,D$
  19. 270   FOR I=0 TO ENTRIES
  20. 280     IF F$=F$(I) THEN D$(I)=D$
  21. 290     NEXT:NEXT
  22. 300 GOTO 320
  23. 310 RESUME 320
  24. 320 CLOSE #1:ON ERROR GOTO 0
  25. 330 PAGES=INT(ENTRIES/10)
  26. 340 CURR=0
  27. 350 START=CURR*10:FINISH=START+9:IF FINISH>ENTRIES THEN FINISH=ENTRIES
  28. 360 CLS:COLOR 0,15:PRINT STRING$(80,32):LOCATE 1,2 :PRINT SUPER "DIRECTORY";TAB(70);"DRIVE ";DRIVE$:LOCATE 1,40-LEN(DISKNAME$)/2:PRINT DISKNAME$:PRINT
  29. 370 FOR I=START TO FINISH
  30. 380 COLOR 0,15:PRINT "F";LEFT$(MID$(STR$(1+I-START),2)+" ",2);:COLOR 15,0:PRINT " ";F$(I);TAB(18);:COLOR 7:PRINT D$(I):PRINT STRING$(80,196);
  31. 390 NEXT
  32. 400 LOCATE 25,1:COLOR 15,0:PRINT "Press ";:COLOR 0,15:PRINT "F1";:COLOR 15,0:PRINT "to ";:COLOR 0,15:PRINT "F";MID$(STR$(1+FINISH-START),2);:COLOR 15,0:PRINT "to select program.  Press PgUp or PgDn to page, ESC to quit.";
  33. 410 LOCATE 23,32:PRINT "Page #";CURR+1;"of";PAGES+1
  34. 420 A$=INKEY$:IF A$="" THEN 420
  35. 430 IF A$<>CHR$(27) THEN 540
  36. 440 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT " 1. Exit to BASIC  2. Exit to DOS  3. Re-RUN   4. Save descriptions  5. Menu";
  37. 450 A$=INKEY$:IF A$<"1" OR A$>"5" THEN 450
  38. 460 ON VAL(A$) GOTO 470,480,490,500:GOTO 350
  39. 470 COLOR 7:CLS:END
  40. 480 SYSTEM
  41. 490 RUN
  42. 500 ON ERROR GOTO 510:GOSUB 1000:GOTO 350
  43. 510 BEEP:LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:COLOR 31:PRINT "Can't save descpiptions.  ";:COLOR 7:PRINT "Press ";CR$;" to continue:";
  44. 520 IF INKEY$<>CHR$(13) THEN 520
  45. 530 RESUME 350
  46. 540 IF A$=CHR$(0)+CHR$(81) THEN CURR=-(CURR+1)*(CURR<PAGES):GOTO 350
  47. 550 IF A$=CHR$(0)+CHR$(73) THEN CURR=CURR-1:CURR=CURR-(PAGES+1)*(CURR<0):GOTO 350
  48. 560 A=ASC(MID$(A$+"0",2))-59:IF A<0 OR A>FINISH-START THEN BEEP:GOTO 420
  49. 570 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT "Press ";CR$;" to run program, ESC to return to menu, SPACE to do description.";
  50. 580 LOCATE 3+A*2,5:COLOR 31:PRINT F$(START+A);:COLOR 15
  51. 590 A$=INKEY$:IF A$<>CHR$(13) AND A$<>CHR$(27) AND A$<>CHR$(32) THEN 590
  52. 600 IF A$=CHR$(27) THEN LOCATE 3+A*2,5:PRINT F$(START+A);:GOTO 400
  53. 610 IF A$<>CHR$(32) THEN 670
  54. 620 IF DISKNAME$="" THEN LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:LINE INPUT;"Enter name of disk : ";DISKNAME$ :GOTO 620
  55. 630 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:Z=START+A:PRINT "Description :";D$(Z);:LOCATE 25,15:LINE INPUT ;D$(Z):D$(Z)=LEFT$(" "+D$(Z),62):GOTO 350
  56. 640 LOCATE 25,1:PRINT SPACE$(79);:BEEP:COLOR 31:LOCATE 25,1:PRINT "Cannot save descriptions to disk.  ":COLOR 7:PRINT "Run program anyway? (Y/N):";:COLOR 7
  57. 650 A$=INKEY$:IF A$<>"Y" AND A$<>"y" AND A$<>"N" AND A$<>"n" THEN 650
  58. 660 IF A$="Y" OR A$="y" THEN RESUME 680 ELSE RESUME 350
  59. 670 ON ERROR GOTO 640:GOSUB 1000
  60. 680 ON ERROR GOTO 690:COLOR 7:CLS:RUN DRIVE$+F$(START+A)
  61. 690 LOCATE 25,1:PRINT SPACE$(79):COLOR 23:BEEP:PRINT "Cannot run ";F$(A);".  ";:COLOR 7:PRINT "Press ";CR$;" to continue...";
  62. 700 IF INKEY$<>CHR$(13) THEN 700
  63. 710 RESUME 350
  64. 720 END
  65. 1000 ' SAVE DESCRIPTIONS TO DISK
  66. 1010 OPEN DRIVE$+"DESCR.DIR" FOR OUTPUT AS #1
  67. 1020 PRINT #1,DISKNAME$;CHR$(13);ENTRIES;CHR$(13);
  68. 1030 FOR I=0 TO ENTRIES:PRINT #1,F$(I);CHR$(13);D$(I);CHR$(13);:NEXT
  69. 1040 CLOSE #1:ON ERROR GOTO 0:RETURN
  70. 1050 '
  71. 5000 ' THIS SUBROUTINE READS DISK DIRECTORY INTO STRING ARRAY
  72. 5010 ' ENTER WITH FSPEC$, THE FILE SPEC FOR THE FILES COMMAND
  73. 5020 ' EXITS WITH ARRAY F$, AND NUMFILES, THE NUMBER OF FILES
  74. 5030 ' USES A TEMPORARY ARRAY TT$, WHICH IS ERASED AFTER USE
  75. 5040 '
  76. 5050 DEF SEG=0:WIDTH 80
  77. 5060 HEAD=1050:TAIL=1052:BUFFER=1054
  78. 5070 CLS:COLOR 23,0,0:PRINT "Reading disk directory"
  79. 5080 COLOR 0:ON ERROR GOTO 5100
  80. 5090 FILES FSPEC$:ON ERROR GOTO 0:GOTO 5110
  81. 5100 BEEP:COLOR 31:CLS:PRINT "Cannot read directory":COLOR 7:ON ERROR GOTO 0:END
  82. 5110 DIM TT$(24):LOCATE 3,1:COLOR 7:ROWS=0
  83. 5120 ' PUT CODE FOR END INTO BUFFER
  84. 5130 POKE HEAD,30:POKE TAIL,34:POKE BUFFER,0:POKE BUFFER+1,79:POKE BUFFER+2,13:POKE BUFFER+3,28
  85. 5140 LINE INPUT TT$(ROWS)
  86. 5150 IF TT$(ROWS)<>"" THEN ROWS=ROWS+1:GOTO 5130
  87. 5160 'IF NOT DIMMED THEN DIM F$(ROWS*4-1):DIMMED=1
  88. 5170 ROWS=ROWS-1
  89. 5180 FOR I=0 TO ROWS
  90. 5190 FOR J=0 TO 3
  91. 5200 T$=MID$(TT$(I),J*18+1,12)
  92. 5210 IF T$<>"" THEN F$(ENTRIES)=T$:ENTRIES=ENTRIES+1
  93. 5220 NEXT J
  94. 5230 NEXT I
  95. 5240 IF LEN(TT$) <> 0 THEN KILL TT$:ENTRIES=ENTRIES-1
  96. 5250 DEF SEG:RETURN
  97.